home *** CD-ROM | disk | FTP | other *** search
/ CD Classic 39 / CD CLASSIC #39 (1998).iso / EMPRESA / visio / Vistdstd / Install / Data.Z / Query.BAS < prev    next >
BASIC Source File  |  1996-09-04  |  11KB  |  338 lines
  1. Attribute VB_Name = "QUERY"
  2. ' -----------------------------------------------------------------------------
  3. ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
  4. '
  5. ' You have a royalty-free right to use, modify, reproduce and distribute
  6. ' the Sample Application Files (and/or any modified version) in any way
  7. ' you find useful, provided that you agree that Visio has no warranty,
  8. ' obligations or liability for any Sample Application Files.
  9. ' -----------------------------------------------------------------------------
  10. '-- Description : Contains the database support.  The grid control serves as
  11. '--               the viewport onto a query displaying the inventory. All
  12. '--               aspects of the query are maintained here and no direct
  13. '--               access to the grid should occur unless otherwise specified.
  14. '--
  15.  
  16. Option Explicit                                 '-- All Variable Explicit!
  17.  
  18. Dim iDBaseInit As Integer
  19.  
  20. Dim m_iSortIndex As Integer
  21.  
  22. Dim m_dbDatabase As Database
  23. Dim m_MainTable As New TableDef
  24. Dim m_MainTableIdx As New Index
  25.  
  26. Const QI_DBASE_FILE_NAME = "~vbinv.mdb"
  27. Const QI_MTABLE_NAME = "Shapes_Table"
  28. Const QI_MTABLE_IDX_NAME = "MTable_Index"
  29.  
  30. Private Sub AddTableField(iIndex As Integer)
  31. '------------------------------------
  32. '--- AddTableField ------------------
  33. '--
  34. '--   Adds a field to the main table.
  35. '--
  36.  
  37.     Dim TempField As New Field
  38.  
  39.     TempField.Name = FieldNames(iIndex)
  40.     TempField.Type = dbText
  41.     TempField.Size = 255
  42.  
  43.     m_MainTable.FIELDS.Append TempField
  44. End Sub
  45.  
  46. Private Sub ClearGrid()
  47. '------------------------------------
  48. '--- ClearGrid ----------------------
  49. '--
  50. '--   Clears the query grid, erasing any query currently displayed.  To clear
  51. '-- the grid we use RemoveItem on all indexes 1 and greater.  Don't remove
  52. '-- index 0 as it is the fixed title row.  Because we can't remove the last
  53. '-- row I instead clear out the last row's (Row = 1) column text.
  54. '--
  55.   
  56.   Dim iRow As Integer, iCol As Integer
  57.                                                     
  58.   For iRow = (frmMainWindow.ctlQueryGrid.Rows - 1) To 2 Step -1
  59.     frmMainWindow.ctlQueryGrid.RemoveItem iRow      '--   Remove Row
  60.   Next iRow
  61.  
  62.   frmMainWindow.ctlQueryGrid.Row = 1                '-- Go To First Row
  63.  
  64.   For iCol = 0 To frmMainWindow.ctlQueryGrid.Cols - 1  '-- For Every Column...
  65.     frmMainWindow.ctlQueryGrid.Col = iCol              '--   Go To Column
  66.     frmMainWindow.ctlQueryGrid.Text = ""               '--   Reset Contents
  67.   Next iCol
  68. End Sub
  69.  
  70. Private Sub CopyShapesToTable(shpsShapeColl As Visio.Shapes)
  71. '------------------------------------
  72. '--- CopyShapesToTable --------------
  73. '--
  74. '--   Copies the current pages shape collection into the database main table.
  75. '--
  76. '--
  77.  
  78.     Dim I As Integer, strStatus As String
  79.     Dim MTable As Table, shpCurshape As Visio.Shape
  80.  
  81.     Set MTable = m_dbDatabase.OpenTable(QI_MTABLE_NAME)
  82.  
  83.     EmptyTable MTable
  84.     
  85.     For I = 1 To shpsShapeColl.Count              '-- Loop Through Shapes...
  86.         strStatus = "Retrieving Shape " & Str$(I) & " of "
  87.         strStatus = strStatus & Str$(shpsShapeColl.Count)
  88.         StatusLineMsg strStatus                     '-- Update Status Line
  89.  
  90.         Set shpCurshape = shpsShapeColl(I)          '-- Get Next Shape
  91.  
  92.         MTable.AddNew
  93.  
  94.         MTable.FIELDS(IDX_NAME) = "" & shpCurshape.Name & " "
  95.         MTable.FIELDS(IDX_DATA1) = "" & shpCurshape.Data1 & " "
  96.         MTable.FIELDS(IDX_DATA2) = "" & shpCurshape.Data2 & " "
  97.         MTable.FIELDS(IDX_DATA3) = "" & shpCurshape.Data3 & " "
  98.  
  99.         If shpCurshape.Type = visTypeShape Or shpCurshape.Type = visTypeGroup Then
  100.             MTable.FIELDS(IDX_TEXT) = "" & shpCurshape.Text & " "
  101.         Else
  102.             MTable.FIELDS(IDX_TEXT) = " "
  103.         End If
  104.  
  105.         MTable.FIELDS(IDX_WIDTH) = "" & shpCurshape.Cells("Width") & " "
  106.         MTable.FIELDS(IDX_HEIGHT) = "" & shpCurshape.Cells("Height") & " "
  107.  
  108.         MTable.Update
  109.     Next I
  110.  
  111.     MTable.Close
  112.     ClearStatusLine
  113. End Sub
  114.  
  115. Private Sub CopyTableToGrid()
  116. '------------------------------------
  117. '--- CopyTableToGrid ----------------
  118. '--
  119. '--   Copies the shape table to the query grid by first sizing it and then
  120. '-- copying each record into a row.
  121. '--
  122.  
  123.     Dim I As Integer, MTable As Dynaset, ctlGrid As Grid, iCol As Integer
  124.  
  125.     Set MTable = m_dbDatabase.CreateDynaset(QI_MTABLE_NAME)
  126.     Set ctlGrid = frmMainWindow.ctlQueryGrid
  127.  
  128.     If MTable.RecordCount = 0 Then Exit Sub
  129.  
  130.     SetupColumns                                  '-- Display Col Labels
  131.  
  132.     MTable.Sort = "[" & IncludeNames(m_iSortIndex) & "] Asc"
  133.     Set MTable = MTable.CreateDynaset()
  134.     MTable.MoveFirst                              '-- Move To Record
  135.     
  136.     ctlGrid.Rows = MTable.RecordCount + 1         '-- Set Grid Rows
  137.     
  138.     For I = 1 To MTable.RecordCount               '-- Loop Through Shapes...
  139.         ctlGrid.Row = I                           '--   Go To Next Row
  140.         
  141.         For iCol = 0 To IncludeCount() - 1
  142.             ctlGrid.Col = iCol
  143.             ctlGrid.Text = MTable.FIELDS(IncludeNames(iCol)).Value
  144.         Next iCol
  145.  
  146.         MTable.MoveNext                           '--   Go To Next Record
  147.     Next I
  148.  
  149.     MTable.Close
  150.     ClearStatusLine
  151. End Sub
  152.  
  153. Private Sub EmptyTable(TheTable As Table)
  154. '------------------------------------
  155. '--- EmptyTable ---------------------
  156. '--
  157. '--   Deletes all records from the table passed.
  158. '--
  159.  
  160.     If TheTable.RecordCount > 0 Then
  161.         TheTable.MoveFirst
  162.  
  163.         Do Until TheTable.EOF
  164.             TheTable.Delete
  165.             TheTable.MoveNext
  166.         Loop
  167.     End If
  168. End Sub
  169.  
  170. Private Sub FitColumns()
  171. '------------------------------------
  172. '--- FitColumns ---------------------
  173. '--
  174. '--   Fits the columns of the grid to the data within.  Does so by iterating
  175. '-- through each cell in a column, saving the largest text width and setting
  176. '-- the width to it.  We also add a leading space iLead for clipping.
  177. '--
  178.  
  179.     Dim iCol As Integer, iRow As Integer, twipsBiggest As Integer
  180.     Dim strTemp As String, iLead As Integer
  181.     Dim ctlGrid As Grid
  182.  
  183.     Set ctlGrid = frmMainWindow.ctlQueryGrid    '-- Alias Grid Control
  184.     iLead = 90                                  '-- 1/16" = 90 * 1/(72*20)
  185.  
  186.     For iCol = 0 To (ctlGrid.Cols - 1)          '-- For Every Column...
  187.         ctlGrid.Col = iCol                      '--   Set Next Column
  188.         twipsBiggest = 1                        '--   Reset For Each Column
  189.  
  190.         For iRow = 0 To (ctlGrid.Rows - 1)      '--   For Every Row In Column...
  191.             ctlGrid.Row = iRow                  '--     Set Next Row
  192.             strTemp = ctlGrid.Text              '--     Get Cell Text
  193.  
  194.             twipsBiggest = iMax(frmMainWindow.TextWidth(strTemp), twipsBiggest)
  195.         Next iRow
  196.  
  197.         ctlGrid.ColWidth(iCol) = twipsBiggest + iLead
  198.     Next iCol
  199. End Sub
  200.  
  201. Private Function InitDatabase() As Integer
  202. '------------------------------------
  203. '--- InitDatabase -------------------
  204. '--
  205. '--   Initializes the local access database and table for inventory.
  206. '--
  207.  
  208.     Dim I As Integer
  209.  
  210.     InitDatabase = True                             '-- Default To True
  211.  
  212.     If iDBaseInit Then Exit Function
  213.  
  214.     On Error GoTo KillErrorHandler
  215.     Kill QI_DBASE_FILE_NAME
  216.  
  217.     On Error GoTo InitDBaseErrHandler
  218.     StatusLineMsg "Creating New Database..."
  219.     Set m_dbDatabase = CreateDatabase(QI_DBASE_FILE_NAME, dbLangGeneral)
  220.  
  221.     m_MainTableIdx.Name = QI_MTABLE_IDX_NAME
  222.     m_MainTableIdx.Unique = False
  223.     m_MainTableIdx.Primary = True
  224.     m_MainTableIdx.FIELDS = FieldNames(IDX_NAME)
  225.  
  226.     m_MainTable.Name = QI_MTABLE_NAME
  227.  
  228.     StatusLineMsg "Adding Database Fields..."
  229.     For I = 0 To FieldCount() - 1
  230.         AddTableField I
  231.     Next I
  232.  
  233.     m_MainTable.Indexes.Append m_MainTableIdx
  234.     m_dbDatabase.TableDefs.Append m_MainTable
  235.  
  236.     ClearStatusLine
  237.     m_iSortIndex = 0
  238.     iDBaseInit = True
  239.     Exit Function
  240.  
  241. KillErrorHandler:
  242.     Resume Next
  243.  
  244. InitDBaseErrHandler:
  245.     MsgBox "Error Creating Database"
  246.     InitDatabase = False
  247.     ClearStatusLine
  248.  
  249.     Exit Function
  250.     Resume 0
  251. End Function
  252.  
  253. Sub RePaint()
  254. '------------------------------------
  255. '--- RePaint ------------------------
  256. '--
  257. '--   Repaints the database grid control with the current table contents.  Does
  258. '-- not perform a requery.
  259. '--
  260.  
  261.   If Not iDBaseInit Then Exit Sub
  262.  
  263.   BeginWaitCursor                                   '-- Display Wait Cursor
  264.  
  265.   ClearGrid                                         '-- Clear Current Query
  266.   SetupColumns                                      '-- Grid Column Headings
  267.   CopyTableToGrid                                   '-- Display Query
  268.   FitColumns                                        '-- Fit Grid Columns
  269.  
  270.   EndWaitCursor                                     '-- Remove Wait Cursor
  271. End Sub
  272.  
  273. Sub ReQuery(iDocIndex As Integer, iPageIndex As Integer)
  274. '------------------------------------
  275. '--- ReQuery ------------------------
  276. '--
  277. '-- Requery is responsible for reading in the current pages' shapes.  Once
  278. '-- the table is updated the grid is repainted.
  279. '--
  280.   
  281.     Dim docDoc As Visio.DOCUMENT, shpsShapeColl As Visio.Shapes
  282.  
  283.     BeginWaitCursor                                 '-- Display Wait Cursor
  284.  
  285.     If Not InitDatabase() Then                      '-- Error During Init...
  286.         EndWaitCursor                               '--   Reset Wait Cursor
  287.         Exit Sub                                    '--   Get Outa Here
  288.     End If
  289.  
  290.     Dim MTable As Table
  291.     Set MTable = m_dbDatabase.OpenTable(QI_MTABLE_NAME)
  292.     EmptyTable MTable
  293.  
  294.     If Not (iDocIndex > 0 And iPageIndex > 0) Then Exit Sub
  295.  
  296.     AppConnect
  297.     Set docDoc = g_appVisio.Documents(iDocIndex)  '--  "  Document
  298.     Set shpsShapeColl = docDoc.Pages(iPageIndex).Shapes
  299.   
  300.     CopyShapesToTable shpsShapeColl                 '-- Create Shapes Table
  301.                                                     
  302.     EndWaitCursor                                   '-- Remove Wait Cursor
  303. End Sub
  304.  
  305. Sub SetSort(iNewIndex As Integer)
  306. '------------------------------------
  307. '--- SetSort ------------------------
  308. '--
  309. '--   Sets the sort index for the table.
  310. '--
  311. '-- Parameters : iNewIndex - 0 based index to sort by.
  312. '--
  313.     
  314.     m_iSortIndex = iNewIndex
  315. End Sub
  316.  
  317. Private Sub SetupColumns()
  318. '------------------------------------
  319. '--- SetupColumns -------------------
  320. '--
  321. '--   Handles displaying the column headings for the query grid by setting the
  322. '-- grid width to the number of fields and placing the field names into each
  323. '-- column header.
  324. '--
  325.  
  326.   Dim iCol As Integer
  327.  
  328.   frmMainWindow.ctlQueryGrid.Cols = IncludeCount()  '-- Set Grid Columns
  329.   frmMainWindow.ctlQueryGrid.Row = 0                '-- Use Top Row
  330.  
  331.   For iCol = 0 To IncludeCount() - 1                '-- For Every Column...
  332.     frmMainWindow.ctlQueryGrid.Col = iCol           '--   Select Column
  333.     
  334.     frmMainWindow.ctlQueryGrid.Text = IncludeNames(iCol)
  335.   Next iCol
  336. End Sub
  337.  
  338.